(*
This file is part of the Lustre reader

* Copyright (c) 2010, Nicola Camuffo.
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are met:
*     * Redistributions of source code must retain the above copyright
*       notice, this list of conditions and the following disclaimer.
*     * Redistributions in binary form must reproduce the above copyright
*       notice, this list of conditions and the following disclaimer in the
*       documentation and/or other materials provided with the distribution.
*     * Neither the name of Nicola Camuffo, nor the
*       names of its contributors may be used to endorse or promote products
*       derived from this software without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER ''AS IS'' AND ANY
* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE FOR ANY
* DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
* LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
* ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*)


open Lustypes
open Utils
(*open Exceptions*)
(*open Errmessages*)


let quoted s = "'" ^ s ^ "'"


let idcounter = new Utils.counter;;
idcounter#set 100 (* the first 100 "vars" are reserved for index vars *)






(*

(* file name -> file id *)
let filehash = (Hashtbl.create 10 : (_sym,_id)Hashtbl.t)

(* current file -> included files *)
let includedhash = (Hashtbl.create 10 : (_id,_id list)Hashtbl.t)


let get_files id =
  let s = "'"^(string_of_int id)^"' -> included files not found" in
  safe_find includedhash id s

let add_file fid id = 
  let l =
    try
      get_files fid
    with Data_not_found_exception _ -> []
  in
  Hashtbl.replace includedhash fid (l@[id])

*)




(* 
---------------------------------------------------------------------
  PM : [P]ackage / [M]odel
  FN : [F]unction / [N]ode
  ENV : Environment (PM or FN)
	ENT : Entity (PM, FN, type, constant, variable, struct field)
---------------------------------------------------------------------
*)


(* ENTITY *)

(* ENT id -> name *)
let entnamehash = (Hashtbl.create 100 : (_id,_sym)Hashtbl.t)



(* PACKAGES / MODELS *)

(* PM name -> id *)
let pmidhash = (Hashtbl.create 10 : (_sym,_id)Hashtbl.t)

(* package id list *)
let packages = ref []

(* model id list *)
let models = ref []

(* model instance id list *)
let model_instances = ref []


let get_pm_id sym =
  let s = (quoted sym) ^ " -> package or model id not found" in
  safe_find pmidhash sym s

let get_pm_name id =
  let s = (string_of_int id) ^ " -> package or model name not found" in
  safe_find entnamehash id s


(* private function *)
let add sym id =
  let s1 = (quoted sym) ^ " -> package or model name already exists" in
  safe_set pmidhash sym id s1;
  let s2 = (string_of_int id) ^ " -> package or model id already exists" in
  safe_set entnamehash id sym s2

let add_package sym id =
  add sym id;
  packages := !packages @ [id]

let get_packages () = !packages

let add_model sym id =
  add sym id;
  models := !models @ [id]

let get_models () = !models

let add_model_instance sym id =
  add sym id;
  model_instances := !model_instances @ [id]

let get_model_instances () = !model_instances



(* CONTAINED BY PACKAGES / MODELS OR PARAMETRIC NODES / FUNCTIONS *)

(* id -> ENV id *)
let envcontainerhash = (Hashtbl.create 10 : (_id,_id)Hashtbl.t)

(* ENV id -> id list *)
let containedhash = (Hashtbl.create 10 : (_id,_id list)Hashtbl.t)


let get_env_container id =
  let s = (string_of_int id) ^ " -> not contained in any package/model or node/function" in
  safe_find envcontainerhash id s

let set_env_as_container id eid =
  let s1 = (string_of_int id) ^ " -> already contained in environment " ^ (string_of_int eid) in
  safe_set envcontainerhash id eid s1;
  let s2 = (string_of_int eid) ^ " -> already container of " ^ (string_of_int id) in
  safe_set_in_list containedhash eid id s2

let get_contained eid =
  let s = (string_of_int eid) ^ " -> empty environment" in
  safe_find containedhash eid s



(* USED BY PACKAGES / MODELS *)

(* PM id -> PM id list *)
let usedhash = (Hashtbl.create 10 : (_id,_id list)Hashtbl.t)


let get_used pid =
  let s = (string_of_int pid) ^ " -> used packages or models not found" in
  safe_find usedhash pid s

let set_as_used pid id =
  let s = (string_of_int id) ^ " -> already used by " ^ (string_of_int pid) in
  safe_set_in_list usedhash pid id s



(* PROVIDED BY PACKAGES / MODELS *)

(* PM id -> (type, constant, FN id) list *)
let providedhash = (Hashtbl.create 10 : (_id,_id list)Hashtbl.t)


let get_provided pid =
  let s = (string_of_int pid) ^ " -> provided packages or models not found" in
  safe_find providedhash pid s

let set_as_provided pid id = 
  let s = (string_of_int id) ^ " -> already provided by " ^ (string_of_int pid) in
  safe_set_in_list providedhash pid id s



(* NEEDED BY MODELS OR PARAMETRIC NODES / FUNCTIONS *)

(* ENV id -> (type, constant, FN id) list *)
let neededhash = (Hashtbl.create 10 : (_id,_id list)Hashtbl.t)


let get_needed eid =
  let s = (string_of_int eid) ^ " -> needed packages or models not found" in
  safe_find neededhash eid s

let set_as_needed eid id =
  let s = (string_of_int id) ^ " already needed by " ^ (string_of_int eid) in
  safe_set_in_list neededhash eid id s



(* CONSTANTS *)

(* ENV id, const name -> const id *)
let constidhash = (Hashtbl.create 10 : ((_id * _sym),_id)Hashtbl.t)

(* const id -> const (type,value) *)
let constvaluehash = (Hashtbl.create 10 : (_id,(_type * _expression))Hashtbl.t)


let get_constid eid sym =
  let s = (string_of_int eid) ^ "[" ^ sym ^ "] -> constant id not found" in
  safe_find constidhash (eid,sym) s

let get_constname id =
  let s = (string_of_int id) ^ " -> constant name not found" in
  safe_find entnamehash id s

let get_constvalue id =
  let s = (string_of_int id) ^ " -> constant value not found" in
  safe_find constvaluehash id s

let add_const eid id sym t v =
  let s1 = (string_of_int eid) ^ "[" ^ sym ^ "] -> altready exists constant with same name" in
  safe_set constidhash (eid,sym) id s1;
  let s2 = (string_of_int id) ^ " -> altready exists constant with same id" in
  safe_set entnamehash id sym s2;
  let s3 = (string_of_int id) ^ " -> already defined constant" in
  safe_set constvaluehash id (t,v) s3;
  set_env_as_container id eid



(* TYPES *)

(* ENV id, type name -> type id *)
let typeidhash = (Hashtbl.create 10 : ((_id * _sym),_id)Hashtbl.t)

(* type id -> type value *)
let typevaluehash = (Hashtbl.create 10 : (_id,_type)Hashtbl.t)


let get_typeid eid sym =
  let s = (string_of_int eid) ^ "[" ^ sym ^ "] -> type id not found" in
  safe_find typeidhash (eid,sym) s

let get_typename id =
  let s = (string_of_int id) ^ " -> type name not found" in
  safe_find entnamehash id s

let get_typevalue id =
  let s = (string_of_int id) ^ " -> type value not found" in
  safe_find typevaluehash id s

let add_type eid id sym v =
  let s1 = (string_of_int eid) ^ "[" ^ sym ^ "] -> altready exists type with same name" in
  safe_set typeidhash (id,sym) id s1;
  let s2 = (string_of_int eid) ^ " -> altready exists type with same id" in
  safe_set entnamehash id sym s2;
  let s3 = (string_of_int id) ^ " -> already defined type" in
  safe_set typevaluehash id v s3;
  set_env_as_container id eid



(* NODES / FUNCTIONS *)

(* ENV id, FN name -> FN id *)
let fnidhash = (Hashtbl.create 10 : ((_id * _sym),_id)Hashtbl.t)


(* private function *)
let add_fn eid id sym s1 s2 =
  safe_set fnidhash (eid,sym) id s1;
  safe_set entnamehash id sym s2;
  set_env_as_container id eid

let get_fn_id eid sym =
  let s = (string_of_int eid) ^ "[" ^ sym ^ "] -> node or function id not found" in
  safe_find fnidhash (eid,sym) s

let get_fn_name nid =
  let s = (string_of_int nid) ^ " -> node or function name not found" in
  safe_find entnamehash nid s

let add_function eid id sym =
  let s1 = (string_of_int eid) ^ "[" ^ sym ^ "] -> altready exists function with same name" in
  let s2 = (string_of_int id) ^ " -> altready exists function with same id" in
	add_fn eid id sym s1 s2
	
let add_node eid id sym =
  let s1 = (string_of_int eid) ^ "[" ^ sym ^ "] -> altready exists node with same name" in
  let s2 = (string_of_int id) ^ " -> altready exists node with same id" in
	add_fn eid id sym s1 s2



(* NODES / FUNCTIONS VARIABLES *)

(* FN id -> input var id list *)
let inputshash = (Hashtbl.create 10 : (_id,_id list)Hashtbl.t)

(* FN id -> output var id list *)
let outputshash = (Hashtbl.create 10 : (_id,_id list)Hashtbl.t)

(* FN id -> local var id list *)
let localshash = (Hashtbl.create 10 : (_id,_id list)Hashtbl.t)


let get_inputs nid =
  let s = (string_of_int nid) ^ " -> input variables not found" in
  safe_find inputshash nid s

let add_input nid id =
  let s = (string_of_int id) ^ " -> already input variable of " ^ (string_of_int nid) in
  safe_set_in_list inputshash nid id s

let get_outputs nid =
  let s = (string_of_int nid) ^ " -> output variables not found" in
  safe_find outputshash nid s

let add_output nid id =
  let s = (string_of_int id) ^ " -> already output variable of " ^ (string_of_int nid) in
  safe_set_in_list outputshash nid id s

let get_locals nid =
  let s = (string_of_int nid) ^ " -> local variables not found" in
  safe_find localshash nid s

let add_local nid id =
  let s = (string_of_int id) ^ " -> already local variable of " ^ (string_of_int nid) in
  safe_set_in_list localshash nid id s


(* FN id -> additional var id list *)
let additionalshash = (Hashtbl.create 10 : (_id,_id list)Hashtbl.t)


let get_additionals nid =
  let s = (string_of_int nid) ^ " -> additional variables not found" in
  safe_find additionalshash nid s

let add_additional nid id =
  let s = (string_of_int id) ^ " -> already additional variable of " ^ (string_of_int nid) in
  safe_set_in_list additionalshash nid id s



(* VARIABLES *)

(* FN id, var name -> var id *)
let varidhash = (Hashtbl.create 10 : ((_id * _sym),_id)Hashtbl.t)

(* var id -> var type *)
let vartypehash = (Hashtbl.create 10 : (_id,_type)Hashtbl.t)


let get_varid nid sym =
  let s = (string_of_int nid) ^ "[" ^ sym ^ "] -> variable id not found" in
  safe_find varidhash (nid,sym) s

(*
let get_all_varids nid =
  let l = Hashtbl.fold (fun (x,_) id l -> if x = nid then l@[id] else l) varidhash [] in
  List.sort compare l
*)

let get_varname id =
  let s = (string_of_int id) ^ " -> variable name not found" in
  safe_find entnamehash id s

let get_vartype id =
  let s = (string_of_int id) ^ " -> variable type not found" in
  safe_find vartypehash id s

let add_var nid sym id tp =
  let s1 = (string_of_int nid) ^ "[" ^ sym ^ "] -> altready exists variable with same name" in
  safe_set varidhash (nid,sym) id s1;
  let s2 = (string_of_int id) ^ " -> altready exists variable with same id" in
  safe_set entnamehash id sym s2;
  let s3 = (string_of_int id) ^ " -> already defined variable" in
  safe_set vartypehash id tp s3;
  set_env_as_container id nid



(* SUB VARS *)
(* tuple/record/list var id -> simple var id list *)
let simplevarshash = (Hashtbl.create 20 : (_id,_id list)Hashtbl.t)

(*
(* simple var id ->  tuple/record/list var id *)
let complexvarhash = (Hashtbl.create 20 : (_id,_id)Hashtbl.t)
*)

let get_simple_vars id =
  let s = (string_of_int id) ^ " -> simple type variables id not found" in
  safe_find simplevarshash id s

let add_simple_var cid sid =
(*  Hashtbl.replace complexvarhash sid cid; *)
  let s = (string_of_int sid) ^ " -> already as simple type variable of " ^ (string_of_int cid) in
  safe_set_in_list simplevarshash cid sid s



(* STRUCT FIELDS *)

(* record id, field name ->  aux var id *)
let fieldidhash = (Hashtbl.create 10 : ((_id * _sym),_id)Hashtbl.t)


let get_fieldid id sym =
  let s = (string_of_int id) ^ ".[" ^ sym ^ "] -> aux (struct field) variable id not found" in
  safe_find fieldidhash (id,sym) s

let get_fieldname id =
  let s = (string_of_int id) ^ " -> struct field name not found" in
  safe_find entnamehash id s

let add_fieldid rid sym id =
  let s1 = (string_of_int rid) ^ "[" ^ sym ^ "] -> altready exists struct field with same name" in
  safe_set fieldidhash (rid,sym) id s1;
  let s2 = (string_of_int id) ^ " -> altready exists struct field with same id" in
  safe_set entnamehash id sym s2

	
	
(* ASSIGNED EXPRESSIONS *)

(* FN id -> (lhs, rhs) list *)
let assignedexprshash = (Hashtbl.create 10 : (_id,(_typed_lhs * _typed_expression) list)Hashtbl.t)


let get_assigned_exprs nid =
	let s = (string_of_int nid) ^ " -> assigned expressions not found" in
	safe_find assignedexprshash nid s
	
let add_assigned_expr nid lhs rhs =
  let l =
    try
      Hashtbl.find assignedexprshash nid
    with Not_found -> []
  in
  Hashtbl.replace assignedexprshash nid (l@[lhs,rhs])
	
	
(* ASSERTS *)

(* FN id -> (lhs, rhs) list *)
let assertshash = (Hashtbl.create 10 : (_id,_typed_expression list)Hashtbl.t)


let get_asserts nid =
	let s = (string_of_int nid) ^ " -> asserts not found" in
	safe_find assertshash nid s
	
let add_assert nid expr =
  let l =
    try
      Hashtbl.find assertshash nid
    with Not_found -> []
  in
  Hashtbl.replace assertshash nid (l@[expr])
	